home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / cursor.swg / 0030_Spinning Cursor Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  13.6 KB  |  443 lines
  1. {
  2. I (Fire&Ice if you use screen-names) would like to contribute something
  3. to SWAG, if you
  4. like it. It is a modified spinning cursor unit. I found out that the
  5. original spinkey
  6. code (I forgot the authors name, sorry) has an error (as follows):
  7.         If you type:
  8.                 Welcine to the wonderful world of Oz!!!
  9.         And then backspace over it (to change what you say), so it says:
  10.                 Welc
  11.         And then type the following message:
  12.                 Welcome to Houston!
  13.         The String Concatenated will be:
  14.                 Welcome to Houston!erful world of Oz!!!
  15.  
  16. So, I rewrote the stuff to account for the backspace key. I have
  17. included two units:
  18. Cursor.pas and Incl.Pas
  19.  
  20. **Cursor Requires Incl to compile (I guess Incl could be of MISC
  21. classification)
  22. ***PLEEZ Lemme know what you think and whether or not u will put it on
  23. SWAG.
  24. (oh, I did use a little code I got off SWAG for the PCBOut Proc in
  25. CURSOR.PAS)
  26.  
  27. -Thanx
  28.  
  29. Fire&Ice
  30. }
  31.  
  32. Unit Cursor;
  33. { Created By Fire&Ice }
  34. { Last Modified: 11/3/96 }
  35.  
  36. (* This Unit Contains Several Useful Procedures For A Spinning Cursor
  37. Shape.
  38.    It Serves No Real Purpose, But It's Cooler Than The Normal Cursor.
  39.    It Contains The Following Procedures:
  40.      SetCursor = Turns The Cursor On/Off.
  41.      Pause2    = A Pretty Neat Pause Procedure With Color
  42.      Spinner   = Actual Procedure For Spinning The Cursor.
  43.      SpinStr   = Reads A String With A Spinning Cursor.
  44.      SpinInt   = Reads An Integer With A Spinning Cursor.
  45.      SpinReal  = Reads A Real With A Spinning Cursor.
  46.      SpinChr   = Reads A Char And Converts and Outputs It In Uppercase.
  47.      PCBOut    = Reads A String And Can Use PCB Color Codes To Format
  48. it.
  49. *)
  50. INTERFACE
  51. Type
  52.   String255=String[255];
  53.  
  54. Const
  55.   On=True;
  56.   Off=False;
  57.   Yes=True;
  58.   No=False;
  59. { These are all the Textcolor() Options...                          }
  60.   Black=0;        { Black                                          }
  61.   DkBlue=1;       { Dark Blue                                      }
  62.   DkGreen=2;      { Dark Green                                     }
  63.   DkTurquoise=3;  { Dark Turquoise                                 }
  64.   DkRed=4;        { Dark Red                                       }
  65.   DkPurple=5;     { Dark Purple                                    }
  66.   Brown=6;        { Brown                                          }
  67.   LtGray=7;       { Standard Text Color (Light Gray)               }
  68.   DkGray=8;       { Dark Gray                                      }
  69.   LtBlue=9;       { Light Blue                                     }
  70.   LtGreen=10;     { Light Green                                    }
  71.   LtTurquoise=11; { Light Turquoise                                }
  72.   LtRed=12;       { Light Red (Pink)                               }
  73.   LtPurple=13;    { Light Purple                                   }
  74.   Yellow=14;      { Yellow                                         }
  75.   White=15;       { White                                          }
  76.   Flash=16;       { Text Attrib for Flashing (Add 16 to Color Num) }
  77.  
  78.   Procedure SetCursor(Flg: Boolean);
  79.   Procedure Pause2(NormCol, CycCol, StarCol:Integer);
  80.   Procedure Spinner;
  81.   Procedure SpinStr(Prpt:String;VAR Inpt:String);
  82.   Procedure SpinInt(Prpt:String;VAR Intg:Integer);
  83.   Procedure SpinReal(Prpt:String;VAR Intg:Real);
  84.   Procedure SpinChr(Prpt:String;VAR Cr:Char);
  85.   Procedure PCBOut(stream:string255; ret:boolean);
  86.  
  87. IMPLEMENTATION
  88. Uses Dos, Crt, Inc;  { cut out INC below !! }
  89.  
  90. Const
  91.   SpinChar:Array[1..4] of Char = ('─','\','│','/');
  92.  
  93. Var
  94.   Key:Char;
  95.   InfoLen:Integer;
  96.  
  97. {**************************************************************************}
  98. Procedure SetCursor(Flg: Boolean);
  99.         Var
  100.           reg : Registers;
  101.  
  102.         Begin
  103.           If Flg=True Then              { Turn cursor on }
  104.          If Mem[$0040:$0049] = 7 Then
  105.               reg.cx := $B0C            { If monochrome monitor }
  106.          Else
  107.            reg.cx := $607               { If color monitor }
  108.           Else                          { Turn cursor off }
  109.             reg.cx := $2020;
  110.           reg.bx := 0;
  111.           reg.ax := $0100;              { Set the interrupt function }
  112.           Intr($10,reg);                { Call the interrupt }
  113.         End;  { of PROCEDURE SetCursor }
  114. {*************************************************************************}
  115. Procedure Pause2(NormCol, CycCol, StarCol:Integer);
  116. Const
  117.   D=115;
  118.   X=38;
  119.   PD:Array[1..6] of Char = ('P', 'A', 'U', 'S', 'E', 'D');
  120.  
  121. Var
  122.   Loop, CurHi:Integer;
  123.   Y:Byte;
  124.   Back:Boolean;
  125.   K:Char;
  126.  
  127. Begin
  128.   SetCursor(False);Writeln;
  129.   CurHi:=1;Y:=WhereY;Back:=False;
  130.   GotoXY(37, Y);CC(StarCol+Flash);Write('*');
  131.   GotoXY(44, Y);Write('*');CC(NormCol);GotoXY(X, Y);
  132.   Repeat
  133.     GotoXY(X, Y);
  134.     For Loop:=1 to 6 Do
  135.       Begin
  136.         For Loop:=1 to 6 Do
  137.           Begin
  138.             If Loop=CurHi Then
  139.               Begin
  140.                 CC(CycCol);
  141.                 Write(PD[Loop]);
  142.               End
  143.               Else
  144.               Begin
  145.                 CC(NormCol);
  146.                 Write(PD[Loop]);
  147.               End;
  148.           End;
  149.     End;
  150.     If CurHi=6 Then
  151.       Begin
  152.         CurHi:=5;
  153.         Back:=True
  154.       End
  155.       Else
  156.       If (Back=True) And (CurHi > 1) Then
  157.         CurHi:=CurHi-1
  158.       Else
  159.       If (Back=True) And (CurHi = 1) Then
  160.         Begin
  161.           CurHi:=2;
  162.           Back:=False
  163.         End
  164.       Else
  165.         CurHi:=CurHi+1;
  166.     Delay(D);
  167.   Until KeyPressed;
  168.   K:=Readkey;GotoXY(43, Y);CC(LtGray);Writeln;
  169.   SetCursor(True);
  170.   End; { of PROCEDURE Pause2 }
  171. {**************************************************************************}
  172. Procedure Spinner;
  173.   Var
  174.     X, Y:Byte;
  175.     Q:Integer;
  176.  
  177.   Begin
  178.     X:=WhereX; Y:=WhereY;
  179.     Q:=1;
  180.     Repeat
  181.       Write(SpinChar[Q]);
  182.       Delay(40);
  183.       GotoXY(X, Y);
  184.       Write(' ');
  185.       GotoXY(X, Y);
  186.       Q:=Q+1;
  187.       If Q = 5 Then
  188.         Q:=1;
  189.     Until KeyPressed;
  190.       Key:=Readkey;
  191.       Write(Key);
  192.       If (Key=Chr(8)) And (InfoLen > 0) Then
  193.         InfoLen:=InfoLen - 1
  194.       Else
  195.         InfoLen:=InfoLen + 1;
  196.   End; { of PROCEDURE Spinner }
  197. {**************************************************************************}
  198. Procedure SpinStr(Prpt:String;VAR Inpt:String);
  199.  
  200.   Label Top;
  201.  
  202.   Var
  203.     Cycler, Cycl2:Integer;
  204.     Tstr, Tstr2:String;
  205.     L:Integer;
  206.  
  207.  
  208.   Begin
  209.     SetCursor(Off);
  210.     Top:
  211.     Write(Prpt);
  212.     Inpt:='';
  213.     InfoLen:=0;
  214.     Tstr:='';
  215.     L:=0;
  216.     Repeat
  217.       Spinner;
  218.       If Key<>Chr(8) Then
  219.         Begin
  220.           L:=L+1;
  221.           Inpt:=Inpt+Key;
  222.         End
  223.         Else
  224.         Begin
  225.           Tstr2:='';
  226.           For Cycl2:= 1 to (L-1) DO
  227.             Begin
  228.               Tstr2:=Tstr2+Inpt[Cycl2];
  229.             End; { of FOR Cycl2 }
  230.           L:=L-1;
  231.           Inpt:=Tstr2;
  232.         End; { of IF Key... }
  233.  
  234.     Until Key=Chr(13);
  235.     Writeln;
  236.     If (InfoLen > 0) Then
  237.       InfoLen:=InfoLen - 1;
  238.  
  239.     If InfoLen > 0 Then
  240.     Begin
  241.       For Cycler:= 1 to InfoLen DO
  242.         Begin
  243.           Tstr:=Tstr+Inpt[Cycler]
  244.         End; { of FOR Cycler }
  245.       Inpt:=Tstr;
  246.     End
  247.     Else
  248.       Begin
  249.         Writeln('ERR: Invalid Entry!');
  250.         goto Top
  251.       End;
  252.    SetCursor(On);
  253.   End; { of PROCEDURE SpinStr }
  254. {**************************************************************************}
  255. Procedure SpinInt(Prpt:String;VAR Intg:Integer);
  256.  
  257.   Var
  258.     Cd:Integer;
  259.     Inpt:String;
  260.  
  261.   Begin
  262.     SpinStr(Prpt, Inpt);
  263.     Val(Inpt,Intg,Cd);
  264.   End; { of PROCEDURE SpinInt }
  265. {**************************************************************************}
  266. Procedure SpinReal(Prpt:String;VAR Intg:Real);
  267.  
  268.   Var
  269.     Cd:Integer;
  270.     Inpt:String;
  271.  
  272.   Begin
  273.     SpinStr(Prpt, Inpt);
  274.     Val(Inpt,Intg,Cd);
  275.   End; { of PROCEDURE SpinReal }
  276. {**************************************************************************}
  277. Procedure SpinChr(Prpt:String;VAR Cr:Char);
  278.   Var
  279.     X, Y:Byte;
  280.  
  281.   Begin
  282.     SetCursor(Off);
  283.     Write(Prpt);
  284.     Spinner;
  285.     X:=WhereX; Y:=WhereY; X:=X-1;
  286.     GotoXY(X, Y);
  287.     Cr:=UpCase(Key);
  288.     Writeln(Cr);
  289.     SetCursor(On);
  290.   End; { of PROCEDURE SpinChr }
  291. {**************************************************************************}
  292. Procedure PCBOut(stream:string255; ret:boolean);
  293.   Var
  294.     _retval:integer;
  295.     out,out1:string[5];
  296.  
  297.   Begin
  298.     For _retval:=1 To length(stream) Do
  299.       Begin
  300.         out:=copy(stream,_retval,1);
  301.         Case out[1] Of
  302.           '@':Begin
  303.                 out1:=copy(stream,_retval+2,1);
  304.                 Case out1[1] Of
  305.                   '0':TextBackground(0);
  306.                   '1':TextBackground(1);
  307.                   '2':TextBackground(2);
  308.                   '3':TextBackground(3);
  309.                   '4':TextBackground(4);
  310.                   '5':TextBackground(5);
  311.                   '6':TextBackground(6);
  312.                   '7':TextBackground(7);
  313.                   '8':TextBackground(8);
  314.                   '9':TextBackground(9);
  315.                   'A':TextBackground(10);
  316.                   'B':TextBackground(11);
  317.                   'C':TextBackground(12);
  318.                   'D':TextBackground(13);
  319.                   'E':TextBackground(14);
  320.                   'F':TextBackground(15);
  321.                 End;
  322.                 out1:=Copy(stream,_retval+3,1);
  323.                 Case out1[1] Of
  324.                   '0':TextColor(0);
  325.                   '1':TextColor(1);
  326.                   '2':TextColor(2);
  327.                   '3':TextColor(3);
  328.                   '4':TextColor(4);
  329.                   '5':TextColor(5);
  330.                   '6':TextColor(6);
  331.                   '7':TextColor(7);
  332.                   '8':TextColor(8);
  333.                   '9':TextColor(9);
  334.                   'A':TextColor(10);
  335.                   'B':TextColor(11);
  336.                   'C':TextColor(12);
  337.                   'D':TextColor(13);
  338.                   'E':TextColor(14);
  339.                   'F':TextColor(15);
  340.                 End;
  341.                 _retval:=_retval+3;
  342.               End;
  343.           Else Write(out[1]);
  344.         End;
  345.       End;
  346.     If ret=Yes Then writeln;
  347.  End; { of PROCEDURE PCBOut }
  348. {**************************************************************************}
  349. End. { of Unit Cursor }
  350.  
  351. { --------------   CUT -------------- }
  352.  
  353. Unit Inc;
  354.  
  355. { Created By: Fire&Ice }
  356. { Last Modified: 10/11/96 }
  357. INTERFACE
  358.  
  359. Function Right(Strng:string;numbr:byte):string;
  360. Function Left(Strng:string;numbr:byte):string;
  361. Procedure Pause;
  362. Procedure CC(col:integer);
  363. Procedure BC(col:integer);
  364. Procedure Cnt_Txt (txt:string);
  365.  
  366. Const
  367. { These are all the Textcolor() Options...                          }
  368.   Black=0;        { Black                                          }
  369.   DkBlue=1;       { Dark Blue                                      }
  370.   DkGreen=2;      { Dark Green                                     }
  371.   DkTurquoise=3;  { Dark Turquoise                                 }
  372.   DkRed=4;        { Dark Red                                       }
  373.   DkPurple=5;     { Dark Purple                                    }
  374.   Brown=6;        { Brown                                          }
  375.   LtGray=7;       { Standard Text Color (Light Gray)               }
  376.   DkGray=8;       { Dark Gray                                      }
  377.   LtBlue=9;       { Light Blue                                     }
  378.   LtGreen=10;     { Light Green                                    }
  379.   LtTurquoise=11; { Light Turquoise                                }
  380.   LtRed=12;       { Light Red (Pink)                               }
  381.   LtPurple=13;    { Light Purple                                   }
  382.   Yellow=14;      { Yellow                                         }
  383.   White=15;       { White                                          }
  384.   Flash=16;       { Text Attrib for Flashing (Add 16 to Color Num) }
  385. { Number of Columns in the Screen (For Procedure Cnt_Txt) }
  386.   NumCols=80;
  387.  
  388. IMPLEMENTATION
  389. uses Crt;
  390.  
  391. {***************************************************************************}
  392. FUNCTION Right(Strng:string;numbr:byte):string;
  393. Var
  394.  loc:byte;                                        { Like The MSBasic }
  395.                                                   { Right Procedure }
  396. Begin
  397.   If numbr >= LENGTH(Strng) then
  398.     Right:=strng
  399.   Else
  400.     Begin
  401.       loc:=length(strng)-numbr+1;
  402.       Right:=copy(strng,loc,numbr);
  403.     End;
  404. End;
  405. {***************************************************************************}
  406. FUNCTION Left(Strng:string;numbr:byte):string;       { Like The MSBasic
  407. }
  408.   Begin                                              { Left Procedure }
  409.     Left:=COPY(Strng,1,numbr);
  410.   End;
  411. {***************************************************************************}
  412. Procedure Pause;                      { This Procedure pauses the
  413. program }
  414. Var
  415.   Wtt:Char;
  416.  
  417.   Begin
  418.     writeln;write('Press Any Key To Continue...');Wtt:=readkey;writeln;
  419.   End;
  420. {***************************************************************************}
  421. Procedure CC(col:integer);      { Easier than typing Textcolor() }
  422.   Begin
  423.     Textcolor(col);           { ** CC stands for 'Color Change' ** }
  424.   End;
  425. {***************************************************************************}
  426. Procedure BC(col:integer);    { Easier than typing Textbackground() }
  427.   Begin
  428.     Textbackground(col);    { ** BC stands for 'Background Change' ** }
  429.   End;
  430. {***************************************************************************}
  431. Procedure Cnt_Txt (txt:string);         { This Procedure does the }
  432. Var
  433.   shft:integer;                     { task of centering a line of text }
  434.  
  435.   Begin
  436.     Shft:=(NumCols - Length(txt)) DIV 2;
  437.     Shft:=Shft+Length(txt);
  438.     Writeln(txt:shft);
  439.   End;
  440. {***************************************************************************}
  441. End.
  442.  
  443.